Developer CD Series 1998 January: Mac OS SDK/Dev.CD Jan 98 SDK2.toast/Development Kits (Disc 2)/ScriptX/Code Samples/colrpick/colrpick.sx

Text File | 1996-05-21 | 9.1 KB | 274 lines | [TEXT/ttxt]

in module ColorPickerModule

--*******************************************************************************
--*        Class name:    ColorMapShape
--*
--*     Inherits from: TwoDShape
--*        Class type: Concrete
--*         Component: Presenters
--*
--*       Description: This is a subclass of TwoDShape whose boundary is a
--*                    graphical representation of the given colormap.
--*
--*             Usage: cms := new ColorMapShape colorMap:colorMap \
--*                                             shapeSize:shapeSize
--*
--*               IVs:    none
--*
--*           Methods:    init
--*
--*    Required files:    none
--*
--*             Notes:
--*
--*            Author:    Steve Mayer - Kaleida Labs, Inc.
--*******************************************************************************
class ColorMapShape (TwoDShape)
end

--*=============================================================================*
--*       Method name:    init
--*             Class:    ColorMapShape
--*             Usage: init self [colormap:<Colormap>]
--*                              [shapeSize:<Number>]
--*-----------------------------------------------------------------------------*
--*       Description: Creates a TwoDShape whose boundary is a graphical
--*                    representation of the given colormap.
--*                    Default values:
--*                        colormap  - (defaultColormap)
--*                        shapeSize - (10)
--*=============================================================================*
method init self {class ColorMapShape} #rest args \
                                       #key colorMap:(defaultColorMap) \
                                             shapeSize:(10) ->
(
    local b := new BitmapSurface colorMap:colorMap \
                 bBox: (new Rect x2:(16 * (shapeSize - 1)) y2:(16 * (shapeSize - 1)))
    local r := new Rect x2:shapeSize y2:shapeSize
    local c, xOffset, yIndex, yOffset
    local shapeStroke := (new Brush color:(new RGBColor red:50 green:50 blue:50))

    for i := 1 to 256 do
    (
        local pc := getNth colorMap i
        if (pc <> empty) do
        (
            c := new Brush color:pc
            xOffset := (shapeSize - 1) * (mod (i - 1) 16)
            yIndex := floor((i - 1) / 16)
            yOffset := (shapeSize - 1) * yIndex
            fill b r b.bBox (translate identityMatrix xOffset yOffset) c
            stroke b r b.bBox (translate identityMatrix xOffset yOffset) shapeStroke
        )
    )

    apply nextMethod self boundary:b args

    return self
)



--*******************************************************************************
--*        Class name:    ColorPicker
--*
--*     Inherits from: TwoDSpace
--*        Class type: Concrete
--*         Component: Spaces
--*
--*       Description: This is a subclass of TwoDSpace which contains
--*                    graphical representation of the given colormap. To
--*                    pick a color, just move the mouse over the space and click
--*                    on the desired color.
--*
--*             Usage: cp := new ColorPicker manager:<some shape>
--*
--*               IVs:    mmev
--*                    mdev
--*                    manager            -- The object to be informed of the color
--*                                        change.
--*                    colorMap        -- The palette of available colors.
--*                    shapeSize        -- The size of each color rectangle.
--*                    currentColor    -- The currently selected color.
--*                    selection        -- A TwoDShape which overlays the selected
--*                                        color.
--*
--*           Methods:    getCurrentColor
--*                    mouseMove
--*                    mouseDown
--*                    init
--*                    afterLoading
--*
--*    Required files:    none
--*
--*             Notes:
--*
--*            Author:    Steve Mayer, Su Quek - Kaleida Labs, Inc.
--*******************************************************************************
class ColorPicker (TwoDSpace)
instance variables
    mmev
    mdev
    manager
    colorMap
    shapeSize
    sampleFill
    sampleStroke
    currentColor
    selection
end


--*=============================================================================*
--*       Method name:    getCurrentColor
--*             Class:    ColorPicker
--*             Usage: getCurrentColor self localCoords
--*-----------------------------------------------------------------------------*
--*       Description: Determines the color that is selected and moves the
--*                    selection box to that location in the space.
--*=============================================================================*
method getCurrentColor self {class ColorPicker} localCoords ->
(
    local shapeSize := self.shapeSize
    local x := ((floor (localCoords.x / (shapeSize - 1)) + 1))
    local y := (floor (localCoords.y / (shapeSize - 1)))
    local i := (y * 16) + x

    if (0 < i and i <= 256 and self.currentColor <> i) do
    (
        self.currentColor := i
        self.selection.x := (x - 1) * (shapeSize - 1) + 2
        self.selection.y := y * (shapeSize - 1) + 2
    )

    return (new Brush color:(getNth self.colorMap i))
)

--*=============================================================================*
--*       Method name:    mouseMove
--*             Class:    ColorPicker
--*             Usage: mouseMove self ev
--*-----------------------------------------------------------------------------*
--*       Description: Highlights the color that the mouse cursor is over.
--*=============================================================================*
method mouseMove self {class ColorPicker} interest ev ->
(
    getCurrentColor self ev.localCoords
)

--*=============================================================================*
--*       Method name:    mouseDown
--*             Class:    ColorPicker
--*             Usage: mouseDown self ev
--*-----------------------------------------------------------------------------*
--*       Description: Changes the color of the manager to the color at the
--*                    location where the mouse is clicked.
--*=============================================================================*
method mouseDown self {class ColorPicker} interest ev ->
(
    local b := getCurrentColor self ev.localCoords
    local theManager := self.manager

    if (theManager <> undefined) do
        colorChanged theManager b
)

--*=============================================================================*
--*       Method name:    init
--*             Class:    ColorPicker
--*             Usage: init self [manager:<Object>]
--*                              [colormap:<Colormap>]
--*                              [shapeSize:<Number>]
--*-----------------------------------------------------------------------------*
--*       Description: Creates a TwoDSpace and initializes its IVs to the default
--*                    values unless another is explicitly given.
--*                    Default values:
--*                        manager      - (undefined)
--*                        colormap  - (defaultColormap)
--*                        shapeSize - (10)
--*=============================================================================*
method init self {class ColorPicker} #rest args #key manager:(undefined) \
                                                     colorMap:(defaultColorMap) \
                                                     shapeSize:(10) ->
(
    local r := new Rect x2:(16 * (shapeSize - 1) + 4) \
                        y2:(16 * (shapeSize - 1) + 4)
    apply nextMethod self boundary:r args
    self.fill := whiteBrush
    self.stroke := blackBrush

    self.manager := manager
    self.colorMap := colorMap
    self.currentColor := 1
    self.shapeSize := shapeSize

    return self
)

--*=============================================================================*
--*       Method name:    afterInit
--*             Class:    ColorPicker
--*             Usage: afterInit self [manager:<Object>]
--*                              [colormap:<Colormap>]
--*                              [shapeSize:<Number>]
--*-----------------------------------------------------------------------------*
--*       Description: Create the selection box and the mouse move and mouse
--*                    down events.
--*=============================================================================*
method afterInit self {class ColorPicker} #rest args #key manager:(undefined) \
                                                     colorMap:(defaultColorMap) \
                                                     shapeSize:(10) ->
(
    --*=========================================================================*
    --* Create the colormap shape and append it to the space.
    --*=========================================================================*
    local c := new ColorMapShape colorMap:colorMap shapeSize:shapeSize
    c.position := new Point x:2 y:2
    prepend self c

    --*=========================================================================*
    --* Create the selection box.
    --*=========================================================================*
    self.selection := new TwoDShape boundary:(new Rect x2:shapeSize y2:shapeSize) \
                              stroke:whiteBrush
    prepend self self.selection

    --*=========================================================================*
    --* Create mouse events.
    --*=========================================================================*
    local mDevice := new MouseDevice
    local mmev := new MouseMoveEvent
    mmev.eventReceiver := mouseMove
    mmev.authordata := self
    mmev.device := mDevice
    mmev.presenter := c
    addEventInterest mmev
    self.mmev := mmev

    local mdev := new MouseDownEvent
    mdev.eventReceiver := mouseDown
    mdev.authordata := self
    mdev.device := mDevice
    mdev.presenter := c    -- Workaround because closures can't refer to self.
    addEventInterest mdev
    self.mdev := mdev

    return self
)

--*=============================================================================*
--*       Method name:    afterLoading
--*             Class:    ColorPicker
--*             Usage: afterLoading self str
--*-----------------------------------------------------------------------------*
--*       Description: Load the mouse move and mouse down events.
--*=============================================================================*
method afterLoading self {class ColorPicker} str ->
(
    nextmethod self str
    load self.mmev
    load self.mdev
)

"Loaded colrpick.sx"